home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 4 / The 640 Meg Shareware Studio CD-ROM Volume IV (Data Express)(1994).ISO / clang / 120_01.zip / META41.C < prev    next >
Text File  |  1993-06-01  |  7KB  |  562 lines
  1. /* HEADER: CUG120.15;
  2.    TITLE: META4;
  3.    VERSION: 1.0;
  4.    DATE: 08/00/1981;
  5.    DESCRIPTION: "Dr. W.A. Gale's META4 compiler-compiler from DDJ August 1981";
  6.    KEYWORDS: compiler-compiler,programming languages;
  7.    SYSTEM: CP/M;
  8.    FILENAME: META41.C;
  9.    CRC: 7C04;
  10.    AUTHORS: W.A.Gale, Jan Larsson;
  11.    COMPILERS: BDS C;
  12.    REFERENCES: AUTHORS: W.A.Gale; TITLE: "META4 Compiler-Compiler";
  13.     CITATION: "Doctor Dobb's Journal, August 1981" ENDREF;
  14. */
  15.  
  16. #include "meta40.h"
  17.  
  18. #define BOOL aa = TRUE ; else aa = FALSE ;
  19.  
  20.  
  21.  
  22.  
  23.  
  24. fds()
  25. {
  26.     
  27.  
  28.     if(iaa < i00)aa = TRUE ; else aa = FALSE ;
  29.     if(aa){
  30.         bb = 1 ;
  31.         iaa = -iaa ;
  32.         }
  33.     else bb = 0 ;
  34.     if(iaa == i00)aa = TRUE ; else aa = FALSE ;
  35.     if(aa){
  36.         nd = c1 ;
  37.         ds[c0] = x0 ;
  38.         }
  39.     else {
  40.         nd = c0 ;
  41.         while(TRUE){
  42.             if(i00 < iaa)aa = TRUE ; else aa = FALSE ;
  43.             if(!aa)break;
  44.             iyy = iaa / i10 ;
  45.             ibb = i10 * iyy ;
  46.             ixx = iaa - ibb ;
  47.             iaa = iyy ;
  48.             aa = ixx ;
  49.             aa = aa + x0 ;
  50.             ds[nd] = aa ;
  51.             nd++;
  52.             }
  53.         }
  54.     ds[nd] = cm ; 
  55.     nd = nd + bb ; 
  56. }
  57.  
  58. fck()
  59. {
  60.     if(er != c0)aa = TRUE ; else aa = FALSE ;
  61.     if(aa){
  62.         puts("Cant open ");
  63.         iaa = ibk ;
  64.         fpn();
  65.         putchar('\n');
  66.         exit();
  67.         }
  68. }
  69.  
  70.  
  71. ffi()
  72. {
  73.     
  74.  
  75.     qi++;
  76.     cc = ri[qi];
  77.     switch (cc) {
  78.         case 'm' : 
  79.             qi++;
  80.             cc = ri[qi];
  81.             fzn();
  82.             if(aa)bb = cc - x0 ;
  83.             else {    
  84. loc11:
  85.                 puts("Index mem cell\n");
  86.                 bb = 0 ;
  87.                 }
  88.             if(bb < mk)aa = TRUE ; else aa = FALSE ;
  89.             if(aa){
  90.                 iaa = bb ;
  91.                 iaa = iaa + itu ;
  92.                 itu = imi[iaa];
  93.                 return;
  94.                 }
  95.             else {
  96.                 bb = bb - mk ;
  97.                 if(bb < mk)aa = TRUE ; else aa = FALSE ;
  98.                 if(aa){
  99.                     iaa = bb ;
  100.                     iaa = itu + iaa ;
  101.                     aa = mc[iaa];
  102.                     itu = aa ;
  103.                     }
  104.                 else goto loc11 ;
  105.                 }
  106.             break ;
  107.         case 's' : 
  108.             aa = itu ;
  109.             bb = os[aa];
  110.             itu = bb ;
  111.             break;
  112.         default : qi-- ;
  113.         }
  114. }
  115.  
  116.  
  117. fft()
  118. {
  119.     
  120.  
  121.     cc = ri[qi];
  122.     switch (cc) {
  123.         case'y' : 
  124.             itu = iys[yp];
  125.             break;
  126.         case '!' : 
  127.             itu = iys[yp];
  128.             fpy();
  129.             break;
  130.         case 'z' : 
  131.             itu = izs[zp];
  132.             if(zp == c0)aa = TRUE ; else aa = FALSE ;
  133.             if(aa){
  134.                 puts("Z stacker\n");
  135.                 zp = c1 ;
  136.                 fl = 0 ;
  137.                 }
  138.             else ;
  139.             zp-- ;
  140.             break;
  141.         case 'n' : 
  142.             qi++;
  143.             aa = ri[qi];
  144.             qi++;
  145.             bb = ri[qi];
  146.             pack(&itu,&aa,&bb);
  147.             break;
  148.         case 'h' : 
  149.             itu = iys[yp];
  150.             unpack(&itu,&aa,&bb);
  151.             itu = aa ;
  152.             break;
  153.         case 'b' : 
  154.             itu = po ;
  155.             break;
  156.         case 'u' : 
  157.             iaa = ipt ;
  158. loc38:
  159.             iaa++;
  160.             itu = ist[iaa];
  161.             break;
  162.         case 'v' : 
  163.             iaa = ipt ;
  164.             iaa++;
  165.             goto loc38;
  166.             break;
  167.         default:   
  168.             fzn();
  169.             if(aa)aa = cc - '0' ;
  170.             else {
  171.                 puts("Illegal fetch\n");
  172.                 aa = c0 ;
  173.                 }
  174.             itu = ipr[aa];
  175.         }
  176. }
  177.  
  178.  
  179. fgi()
  180. {
  181.     
  182.  
  183.     pi = 0 ;
  184.     li = ks[ipc];
  185.     ipc++;
  186.     while(TRUE){
  187.         if(pi < li)aa=TRUE;else aa = FALSE ;
  188.         if(!aa)break;
  189.         aa = ks[ipc];
  190.         ipc++;
  191.         ri[pi] = aa ;
  192.         pi++;
  193.         }
  194. }
  195.  
  196.  
  197.  
  198. fin()
  199. {
  200.     
  201.  
  202.     zx = yp = zp = izc = izt = 0 ;
  203.     xa = 'a' ;
  204.     xb = 'b' ;
  205.     xc = 'c' ;
  206.     xd = 'd' ;
  207.     xe = 'e' ;
  208.     xf = 'f' ;
  209.     xg = 'g' ;
  210.     xh = 'h' ;
  211.     xi = 'i' ;
  212.     xj = 'j' ;
  213.     xk = 'k' ;
  214.     xl = 'l' ;
  215.     xm = 'm' ;
  216.     xn = 'n' ;
  217.     xo = 'o' ;
  218.     xp = 'p' ;
  219.     xq = 'q' ;
  220.     xr = 'r' ;
  221.     xs = 's' ;
  222.     xt = 't' ;
  223.     xu = 'u' ;
  224.     xv = 'v' ;
  225.     xw = 'w' ;
  226.     xx = 'x' ;
  227.     xy = 'y' ;
  228.     xz = 'z' ;
  229.     x0 = '0' ;
  230.     x1 = '1' ;
  231.     x2 = '2' ;
  232.     x3 = '3' ;
  233.     x9 = '9' ;
  234.     c9 = 9 ;
  235.     cv = 25 ;
  236.     c0 = 0 ;
  237.     c1 = 1 ;
  238.     c2 = 2 ;
  239.     c3 = 3 ;
  240.     cb = ' ' ;
  241.     cx = '!' ;
  242.     cs = '*' ;
  243.     cm = '-' ;
  244.     cp = '+' ;
  245.     cg = '>' ;
  246.     cu = '=' ;
  247.     cl = '<' ;
  248.     sd = 80 ;
  249.     ct = '\t' ;
  250.     ce = '/' ;
  251.     cd = '.' ;
  252.     cq = '\'' ;
  253.     i00 = 0 ;
  254.     i01 = 1 ;
  255.     i03 = 3 ;
  256.     i10 = 10 ;
  257.     i16 = 16 ;
  258.     mn = 79 ; 
  259.     ibk = iav[c3];
  260.     xclose( f2 );
  261.     xcreat( ibk, f2 );
  262.     fl = pi = pb = ipc = po = ipt = ilb = pn = iuu = iln = ism = inl = 0 ;
  263.     mk = 2 ;
  264.     fmi(); 
  265. }
  266.  
  267.  
  268. fla()
  269. {
  270.     
  271.  
  272.     if(pl == mn)aa = TRUE ; else aa = FALSE ;
  273.     if(aa)pl = c0 ; else pl++;
  274. }
  275.  
  276.  
  277. flb()
  278. {
  279.     
  280.  
  281.     while(TRUE){
  282.         if(pl != pm)BOOL
  283.         if(!aa)break;
  284.         cc = gchar( f1 );
  285.         if(er != c0)BOOL
  286.         if(aa)cc = 0 ;
  287.         ns[pm] = cc ;
  288.         if(pm == mn)BOOL
  289.         if(aa)pm = 0 ; else pm++;
  290.         }
  291. }
  292.  
  293.  
  294. fli()
  295. {
  296.     
  297.  
  298.     pm = pl = bb = 0 ;
  299.     while(TRUE){
  300.         if(bb <= mn)BOOL
  301.         if(er == c0)cc = TRUE ; else cc = FALSE ;
  302.         aa = aa & cc ;
  303.         if(!aa)break;
  304.         cc = gchar( f1 );
  305.         ns[bb] = cc ;
  306.         bb++;
  307.         }
  308. }
  309.  
  310.  
  311. flw()
  312. {
  313.     
  314.  
  315.     cc = ns[pl];
  316.     while(TRUE){
  317.         if(cc == '\n')BOOL
  318.         if(aa){
  319.             iln++;
  320.             ism = 0 ;
  321.             }
  322.         else ;
  323.         if(cc == ' ')bb = TRUE ; else bb = FALSE ;
  324.         aa = aa | bb ;
  325.         if(cc == '\t')bb = TRUE ; else bb = FALSE ;
  326.         aa = aa | bb ;
  327.         if(!aa)break;
  328.         fla();
  329.         cc = ns[pl];
  330.         }
  331.     flb();
  332. }
  333.  
  334.  
  335.  
  336. fmc()
  337. {
  338.     
  339.     iaa = mk ;
  340.     imt = imt - iaa ;
  341.     fmo();
  342.     iaa = imt ;
  343.     fmz();
  344. }
  345.  
  346.  
  347.  
  348. fmd()
  349. {
  350.     
  351.     iaa = mk ;
  352.     imt = imt + iaa ;
  353.     if(imd < imt)BOOL
  354.     if(aa)puts("Destroy cell error\n");
  355.     else ;
  356.     iaa = imt ;
  357. }
  358.  
  359.  
  360.  
  361. fme()
  362. {
  363.     
  364.     
  365.     fml();
  366.     if(iaa != i00)ee = TRUE ; else ee = FALSE ;
  367.     if(ee)return;
  368.     imi[ibb] = imf ;
  369.     while(TRUE){
  370.         mc[imf] = cc ;
  371.         imi[imf] = imx ;
  372.         imf++;
  373.         fmo();
  374.         if(cc != c0)BOOL
  375.         if(!aa)break;
  376.         bb++;
  377.         cc = os[bb];
  378.         }
  379.     iaa = imf ;
  380.     iaa = imf ;
  381.     idd = mk ;
  382.     imf = imf + idd ;
  383.     fmo();
  384.     fmz();
  385. }
  386.  
  387.  
  388.  
  389. fmh()
  390. {
  391.     
  392.     imi[imf] = imb ;
  393.     imb = imf ;
  394.     imf = imf + iml ;
  395.     mc[imf] = c0 ;
  396.     imi[imf] = i00 ;
  397. }
  398.  
  399.  
  400.  
  401. fmi()
  402. {
  403.     
  404.     imm = imb = 0 ;
  405.     imd = 3000 ; 
  406.     imt = imd ;
  407.     iml = 1 ;
  408.     imf = imb + iml ;
  409.     imx = i00 ;
  410.     imi[imb] = i00 ;
  411.     mc[imf] = c0 ;
  412.     imi[imf] = i00 ;
  413. }
  414.  
  415.  
  416. fml()
  417. {
  418.     
  419.     ibb = imb + iml ;
  420.     bb = 0 ; 
  421.     while(TRUE){
  422.         cc = os[bb];
  423.         dd = mc[ibb];
  424.         if(cc == dd)ee = TRUE ; else ee = FALSE ;
  425.         if(ee){ 
  426.             if(cc == c0)ee = TRUE ; else ee = FALSE ;
  427.             if(ee){ 
  428.                 iaa = ibb + i01 ;
  429.                 goto loc77 ;
  430.                 }
  431.             else ;
  432.             ibb++;
  433.             bb++;
  434.             }
  435.         else { 
  436.             iaa = imi[ibb];
  437.             if(iaa == imx)ee = TRUE ; else ee = FALSE ;
  438.             if(ee){ 
  439.                 iaa = i00 ;
  440.                 goto loc77;
  441.                 }
  442.             else ;
  443.             ibb = iaa ;
  444.             }
  445.         if(ibb < imf)ee = TRUE ; else ee = FALSE ;
  446.         if(!ee)break;
  447.         }
  448.     iaa = i00 ; 
  449. loc77:
  450.     aa = aa ;
  451. }
  452.  
  453.  
  454.  
  455. fmo()        
  456. {    
  457.     
  458.     if(imt < imf)BOOL
  459.     if(aa){
  460.         puts("NO Memory space left, increase array sizes.\n");
  461.         exit();
  462.         }
  463.     else ;
  464.     if(imm < imf)BOOL
  465.     if(aa)imm = imf ;
  466. }
  467.  
  468.  
  469.  
  470. fmp()
  471. {
  472.     
  473.     if(imb != i00)BOOL
  474.     if(aa){
  475.         imf = imb ;
  476.         imb = imi[imb];
  477.         }
  478.     else {
  479.         imf = iml ;
  480.         mc[imf] = c0 ;
  481.         imi[imf] = i00 ;
  482.         }
  483. }
  484.  
  485.  
  486. fms()
  487. {
  488.     
  489.     os[po] = c0 ;
  490.     imz = imb ;
  491.     while(TRUE){
  492.         fml();
  493.         if(iaa == i00)ee = TRUE ; else ee = FALSE ;
  494.         imb = imi[imb] ;
  495.         if(imb != i00)dd = TRUE ; dd = FALSE ;
  496.         cc = ee & dd ;
  497.         if(!cc)break ;
  498.         }
  499.     imb = imz ;
  500. }
  501.  
  502.  
  503.  
  504.  
  505. fmz()
  506. {
  507.     
  508.     bb = 0 ;
  509.     idd = iaa ;
  510.     while(TRUE){
  511.         if(bb < mk)BOOL
  512.         bb++;
  513.         if(!aa)break;
  514.         mc[idd] = c0 ;
  515.         imi[idd] = i00 ;
  516.         idd++;
  517.         }
  518. }
  519.  
  520.  
  521.  
  522.  
  523. fpn()
  524. {
  525.     
  526.     fds();
  527.     while(TRUE){
  528.         ibb = nd ;
  529.         if(i00 < ibb)BOOL
  530.         if(!aa)break;
  531.         nd-- ;
  532.         aa = ds[nd];
  533.         putchar( aa );
  534.         }
  535.     putchar(' ');
  536. }
  537.  
  538.  
  539.  
  540. fpy()
  541. {
  542.     
  543.     if(yp == c0)BOOL
  544.     if(aa){
  545.         puts("Y stacker\n");
  546.         yp = c1 ;
  547.         fl = 0 ; 
  548.         }
  549.     else ;
  550.     yp-- ;
  551. }
  552.  
  553.  
  554.  
  555.  
  556.  
  557.  
  558. o();
  559.         if(cc != c0)BOOL
  560.         if(!aa)break;
  561.         bb++;
  562.         cc = os[bb];